00010	C*****  SUBRS NOTES, BMX, ACSHFT  ***********
00055	
00100		SUBROUTINE NOTES
00200		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
00300		COMMON/SCX/RHY(4),JALPHA(30),JX,RA,JZ,IRHY,RB,KA,KB,IZ
00310		COMMON /XRN/RN(2000) /DPY/ST(4000),WDS(250),MEDIT,GO	
00400		COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA
00500		1,DBST,NFLG,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
00600	     1 /ALF/CLF,JQX,D,KQ,JG,X,ACC,T,Y,LL,RZ,RC,INP(61) /POS/POS1,POS2
00710		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK
00730		COMMON/RINP/R(10,80),RPOS(2,50) /RMOD/RMODE2,SET4,IBEAM,
00740		1 NOSET,STEM,STUP,NTC,PS2,RAM,RDD,ITB,POSB
00750		DATA ACMV/2.3/
00752		RMODE=0
00756		IF(RMODE2.GE.500)RMODE=RMODE2
00758	C  RMODE2≥500 IS FOR USER-ADDED NOTE AND REST ROUTINE (SUBR EXTRA)
00760		POS1=0
00770		POS2=200
00780		STFLG=0
00800	444	FORMAT(' TYPE POS1, POS2, (SPC)  '$)
00810		CALL SETUP
00815		IF(STUP.GE.0)GO TO 8
00820	CC	IF(ST(3601).GE.0)GO TO 8
00825	C   ST(3601) IS LOC. OF RPOS(1,1)
00830	C SKIPS IF USING SETUP ON STAFF 4
00900	4333	TYPE 444
01100		ACCEPT F78F,POS1,POS2,RA
01150	C  TYPE ANY POSITIVE 3RD NUM. FOR PSUEDO-FIBONACCI SPACING OF RHYTH.
01175		STUP=STUP-RA
01187	C  DON'T USE INVIS. RESTS WITH SPACING FEATURE!!!!
01200		IF(POS2.EQ.0)POS2=200.
01250		IF(POS1.GE.POS2)GO TO 4333
01300	8	KN=0
01400		IRHY=0
01500	C  IZ=# OF ITEMS FROM SCANR*******
01600		IZ=I-1
01650	CC	IF(IZ.GT.50)IZ=50
01675	C  LIMIT OF 50 ITEMS***** IS NOW SET TO 100 4/74 *****
01700		CLF=1
01800		JQX=0
01805	
01810		K=IZ+1
01820		DO 70 KQ=1,IZ
01825		JG=V(KQ)
01830		IF(JG.GE.0)GO TO 70
01835		JG=-JG/100
01840		IF(JG.EQ.0)GO TO 170
01845		IF(JG.EQ.10)GO TO 170
01850		IF(JG.EQ.100)GO TO 70
01855		IF(JG.NE.1000)GO TO 70
01860	C TO GET THE RIGHT ITEM COUNT WITH CHORDS, ETC.
01870	170	K=K-1
01880	70	CONTINUE
01890	
01900		D=(POS2-POS1)/K
02000	C   D WILL SPACE ALL ITEMS EVENLY FOR NOW
02100	
02150		STEM=-1
02200	C   K=COUNTER FOR USEFUL ITEMS (OMITS CLEFS)
02400		K=1
02410		KQ=1
02420	C   LOOPS TO 7333 
02430	7	JG=0
02465	C  IN V ARRAY -- NOTES ARE 1-98, 1000-1000000; NEG. VALUES ARE CHORD NOTES.
02500		X=V(KQ)
02510		IF(X)GO TO 27
02520	C NEXT SORTS OUT ORDER OF CHORD
02530		RZ=V(KQ+1)
02540		IF(RZ.GT.0)GO TO 27
02550		IF(RZ.GT.-99)GO TO 327
02555		IF(RZ.GT.-1000)GO TO 27
02557	C  SKIPS NON-NOTES  (NOTES ARE -1→-98;   ¬1000→[ACCIS])
02560	327	RZ=AMOD(X,100.0)
02570	57	LL=KQ
02580		Y=0
02590		RA=RZ
02600	37	LL=LL+1
02605		T=RA
02610		RA=-V(LL)
02620		IF(RA)GO TO 27
02630		IF(RA.LT.99)GO TO 427
02635		IF(RA.LT.1000)GO TO 27
02637	C  EXITS WITH NON-NOTES
02640	427	RA=AMOD(RA,100.0)
02650	C  GETS RID OF ACCI. FOR NOW
02660		IF(Y)127,97,67
02670	C Y IS STEM DIRECTION.  -1=DOWN, 1=UP
02680	97	Y=RA-T
02700		GO TO 37
02705	67	IF(RA.LT.RZ)V(LL)=-RA-7
02707	C TRAP FOR NOTE IN WRONG OCT. (CONFUSES STEM DIRECTION.)
02710		IF(RA.GE.T)GO TO 37
02720	227	CALL EXCH(V(LL),V(LL-1))
02730	C NOW START OVER AGAIN
02740		GO TO 57
02745	127	IF(RA.GT.RZ)V(LL)=-RA+7
02750		IF(T.GT.RA)GO TO 37
02760		GO TO 227
02900	
03210	27	ACC=0
03220		RA=2.
03230		DO 89 LL=4,10
03240	89	R(LL,K)=0
03250	C   TO CLEAR END OF ITEM
03260		IF(X.LT.0)GO TO 86
03270	C  JUMP IF A CLEF OR BAR OR METER
03300		IRHY=IRHY+1
03400	C   ADDS A RHYTHMIC UNIT
03500		GO TO 2333
03520	C  TO CLEAR LAST PARAMS IN SOME ITEMS LATER
03600	86	IF(IFIX(AMOD(X,100.0)).EQ.-99)GO TO 84
03700	C   JUMP IF A CLEF 
03750		IF(X.GE.-599)GO TO 77
03762		IF(X.GT.-619)GO TO 84
03768	C  -619 IS 1- TOP # FOR DBL BAR (MD9)
03775	C  FOUND AN EXTENDED BARLINE?
03800	77	IF(X.LT.-1.)GO TO 2333
03900	C  JUMP IF IT'S A DBLSTP
04000		RA=18.
04100		L=-X*100.
04200		Y=L
04300		R(6,K)=-(X+Y/100.)*10000.+.0001
04400	C   GETS BOTTOM NUM OF METER
04500		X=85.
04550	842	R(5,K)=Y
04600		GO TO 843
04700	84	T=CLF
04800		CLF=-(99.+X)/100.
04810		IF(AMOD(CLF,1.).EQ.0)GO TO 841
04815		IF(CLF.GT.5.0)GO TO 841
04820	C  IS THE CLEF INVISIBLE?
04830		CLF=IFIX(CLF)
04840		GO TO 871
04850	841	RZ=X
04900		X=85.
05000	C   WILL SKIP LATER
05100		Y=CLF
05150		LL=Y
05200		RA=3.
05300	CC	IF(LL.LT.5)GO TO 83
05400	C   CLF5 = BAR LINE
05410		IF(LL-5)851,41,40
05415	CC	IF(LL.EQ.5)GO TO 41
05417	40	IF(LL.GT.7)GO TO 83
05420		STEM=(CLF-5)*10.
05425		CLF=T
05430	C CONTROLS STEM DIREC. UNTIL CHNGD. SU(LL=6) OR SD(LL=7)
05440		GO TO 871
05470	CC41	IF(LL.NE.5)GO TO 83
05500	41	RA=4.
05700		Y=1.
05705		IF(LL.NE.CLF)Y=-RZ-599.
05720	C 'M'=1 STF.  'M2'=2 STAVES, ETC.
05740		IF(Y.GE.10.)Y=1490.+Y
05765	C  TYPE 'MDn' FOR HEAVY DBL BAR (←)
05790	831	CLF=T
05800		GO TO 85
05900	CC83	IF(Y.LT.10.)GO TO 851
06000	C  NOW A KSIG.
06100	83	RA=17.
06200		Y=Y/10.
06300		IF(Y.GT.10.)Y=10.-Y
06400	C  CHANGES FLAT TO NEG.
06600		R(6,K)=T-1
06700		CLF=T
06740	CC	GO TO 831
06755		GO TO 842
06770	851	Y=Y-1
06785	C  ↑↑↑↑ FOR NEW CLEFS ROUTINE  6/74
06800		IF(JQX.NE.0)Y=Y+100.
06900		JQX=-1
07000	C   AFTER THE FIRST TIME, THEN MINICLEFS
07010		R(5,K)=Y
07020	843	Y=0
07030	C  FOR NEW CLEF ROUTINE
07100	85	R(4,K)=Y
07150	2333	IF(X.LT.-702)GO TO 3333
07160		IF(X.GT.-700)GO TO 3333
07170	C  FOR NOTES ON STAFF ABOVE OR BELOW.  (2000 ↑    1000 ↓)
07175		STFLG=(X+700)*1000
07187		GO TO 871 
07200	3333	R(2,K)=STAFF
07300		IF(X.GT.0)KN=KN+1
07400		R(3,K)=KN*D+POS1
07410		IF(X.NE.86)GO TO 852
07415		R(8,K)=9999.
07417		GO TO 7333
07420	C FOR INVIS. RESTS - CHECKED IN SUBR. NEWR
07500	852	IF(X.LT.85.)GO TO 1852
07550		IF(X.LT.1000.)GO TO 7333
07600	C  JUMP IF REST, METER, CLEF OR BAR
07610		IF(X.LT.20000)GO TO 1852
07615		IF(X.GE.90000)GO TO 1852
07617	C  +100000=NATURAL SIGN ON NOTE.
07620		Y=6
07630		IF(X.NE.20000)Y=-Y
07640		R(4,K)=Y
07650	C X=20000 = REST UP 6; =20001 = REST DOWN 6 (1/2 REST DN 4)
07655		X=0
07660		GO TO 7333
07700	1852	RA=1.
07800		IF(X.GT.0)GO TO 2133
07900		X=-X
08000		JG=-1
08100	C  DBLSTOP=-1
08200		R(8,K)=-1.
08300	2133	IF(X.LT.1000.)GO TO 433
08400		IF(X.LT.10000.)GO TO 233
08500		IF(X.LT.100000.)GO TO 333
08600		ACC=3.
08700	C  NATURAL
08800		X=X-100000.
08900		GO TO 433
09000	333	ACC=2.
09100	C  SHARP
09200		X=X-10000.
09300		GO TO 433
09400	233	ACC=1.
09500	C  FLAT
09600		X=X-1000.
09700	CC433	Y=AMOD(X,12.0)
09800	CC	IF(Y.EQ.0)Y=12.
09900	CC	J=(Y+1)/2
10000	CC	IF(Y.GT.5.)J=(Y+2)/2
10100	CC	IF(ACC.EQ.0)GO TO 133
10150	CC	IF(ACC.EQ.3.)GO TO 133
10200	CC	IF(ACC.EQ.1.)GO TO 533
10300	CC	IF(Y.EQ.1)GO TO 177
10350	CC	IF(Y.NE.6.)GO TO 133
10375	CC177	J=J-1
10400	CC	GO TO 133
10500	CC533	J=J+1
10510	C  NOW NOTE NUMBERS ARE DIATONIC ONLY (1=C, TO 7=B)  12/75
10520	433	Y=AMOD(X,7.0)
10530		IF(Y.EQ.0)Y=7.
10565		J=Y
10600	133	IF(CLF.EQ.2)GO TO 633
10700		IF(CLF.EQ.3)GO TO 733
10800		IF(CLF.EQ.4)GO TO 833
10900		KA=4
11000		KB=0
11100		GO TO 933
11200	633	KA=2
11300		KB=-2
11400		GO TO 933
11500	733	KA=3
11600		KB=-1
11700		GO TO 933
11800	833	KA=2
11900		KB=-6
12000	CC933	L=(X-1)/12+1
12100	C   L IS OCTAVE
12200	CC	N=(L-KA)*7+J+KB
12210	933	L=(X-1)/7+1
12220		N=(L-KA)*7+J+KB
12300	533	T=10.
12400		IF(N.GE.7)T=20.
12410		IF(STEM.GT.0)T=STEM
12500	C  FOR STEM DIRECTIONS - 'B' AND HIGHER HAVE STEMS DOWN.
12510		IF(STFLG.EQ.0)GO TO 5333
12520	C  STFLG PUTS NOTE ON STAFF ABOVE OR BELOW (-2000, -1000)
12530		RX=-STFLG
12540		IF(N)RX=-RX
12550		N=N+RX
12600	5333	R(4,K)=N
12700	C  N=NOTE #
12800		IF(JG.EQ.0)GO TO 3133
12900	C  JUMP IF NOT DBLSTOP
12910	CC	RZN=0
12920	CC	GO TO 3133
12950	4133	L=K-1
13000		IF(R(5,L).GE.10.)MX=L
13100	C  MX=1ST NOTE OF CHRD
13200		T=0
13300		L=K-MX
13400		IF(N.LT.R(4,MX))L=-L
13500		R(7,MX)=L
13600	C L+=STEM UP, L-=STEM DOWN ... USED AT END OF NOTES.
13700		RZ=ABS(R(4,MX)-FLOAT(N))-1.
13800	C  EXTENDS THE STEM!
13810	CC	IF(RZ.LT.RZN)RZ=RZN
13820	CC	RZN=RZ
13830	C  AFTER 1ST NOTE, ORDER MAY BE SCRAMBLED IN CHORDS.  STEM OK.
13900		IF(RZ.LT.1.)RZ=1.
14000		R(8,MX)=RZ
14100	3133	R(5,K)=ACC+T
14200	
14300	7333	R(1,K)=RA
14325		IF(RA.GT.2)GO TO 500
14331		IF(RMODE.EQ.0)GO TO 500
14337		X=R(4,K)
14340		RA=RMODE
14343		IF(X)RA=-RA
14346		R(4,K)=X+RA
14348	C CHANGES 496 TO -504, ETC.
14350	500	IF(X.LT.87)GO TO 87
14362		RX=-1
14375		IF(X.EQ.87)GO TO 872
14378		RX=X-87
14379		IF(RX.GT.0.5)GO TO 872
14380		RX=0.1
14382		R(5,K)=-4
14383	C /RR/ = REPEAT BAR SIGN. (P5=-4)
14385	C TYPE /RW/ FOR WHOLE REST PRINTOUT, /Rn/ FOR ADDED NUMB.
14387	872	R(8,K)=RX
14390		R(9,K)=-1
14400	87	K=K+1
14500	871	KQ=KQ+1
14600		IF(KQ.LE.IZ)GO TO 7
14700	
14800		IZ=K-1
14900	C  IZ IS NOW REALLY THE NUMBER OF ITEMS TO BE PROCESSED
15100	C  NEXT ADJUSTS PLACEMENT OF ACCIDENTALS AND 2NDS.
15200		K=1
15210	1	RX=R(7,K)
15300		IF(RX.EQ.0)GO TO 2
15350		IF(R(1,K).EQ.2.)GO TO 2
15400	C  JUMP IF NO CHRD COMING
15700		IF(RX.GT.0)GO TO 3
15800	C  JUMP IF STEM IS UP
15900		RA=R(5,K)
16000		IF(RA.LT.10)GO TO 277
16050		IF(RA.LT.20.)R(5,K)=RA+10.
16100	C  PUTS STEM DOWN IF IT WASN'T
16200	277	L=K-RX
16250	C  RX=TOTAL(-1) NOTES IN CHORD
16300		R(7,K)=0
16600	4	RA=R(4,K)
16900		RC=0
17100	C  INTERVAL TO PREVIOUS NOTE
17220	C  CHECK ON USE OF N ELSEWHERE
17250		N=K+1
17300		IF(K.LT.L)RC=RA-R(4,N)
17400	C  INTERVAL TO NEXT NOTE
17500		IF(RC+R(6,K).EQ.1.)R(6,N)=20
17700	C  PUSHES NOTE TO LEFT 
18900	5	K=N
19000		IF(K.GT.L)GO TO 220
19100		GO TO 4
19200	
19300	3	DO 30 M=2,IZ
19400		L=M-1
19500		IF(R(4,M)-R(4,L)+R(6,L).NE.1.)GO TO 30
19550		IF(R(3,M).NE.R(3,L))GO TO 30
19650		R(6,M)=10
19675		R(6,L)=30
19681	30	CONTINUE
19687	C  TO HELP DOTTED NOTES.
19700	C  MOVES NOTE TO RIGHT OF STEM WHEN 2ND.
19900	C  THE STEM IS UP
20000		RA=R(5,K)
20100		IF(RA.GE.20.)R(5,K)=RA-10.
20200	C  PUTS STEM UP IF IT WASN'T
20500		R(7,K)=0
22400		K=1+K+RX
22500	220	CALL ACSHFT(RX)
22510	C  L=K-1=END OF CHORD;  L-ABS(RX)=START OF CHORD; +RX=↑  -RX=↓
22555		GO TO 22
22600	
22700	2	K=K+1
22800	22	IF(K.LE.IZ)GO TO 1
22900		R(1,K)=0
23300		END
23400	
50000		SUBROUTINE BMX(RA)
50050	C  RA=NUMB. OF TAILS
50060		COMMON/RINP/R(10,80),VQ(100)
50070	C  VQ HOLDS TEMPORARY INFO RE. MULTIPLE BEAMS.
50080		COMMON E,F,G,H,RJQ(34),RB,VQX,JB,B,JV,JW /XRN/RN(2000)
50100		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
50200		COMMON/SCX/RHY(4),JALPHA(30),JX,U,JZ,IRHY,JD,KA,KB,IZ
50300		COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /SC/J,L,MK
50400		1 ,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG,IXX,ISEMI,IQT
50500		1 ,VX(50),IAMP,K,KN,M,MODE,IBLA
50700		M=IS-12
50800		DO 1 L=KN,K
50900	1	VQ(L)=AMOD(R(7,L),10.0)
51000		VQ(K+1)=0
51100	C   CLEARS IT FOR ROUTINE AT '3'
51200		JB=KN
51250	
51260	6	RN(IS+10)=0
51280		RN(IS+9)=0
51300		DO 2 L=JB,K
51400		IF(VQ(L).LE.RA)GO TO 2
51500	C  SKIP IF EQ. TO PRESENT BEAM
51600		RB=VQ(L)
51900	4	DO 11 JD=L,K
51950		VQX=VQ(JD)
52000		IF(VQX.GE.RB)GO TO 20
52010		IF(VQX.EQ.0)GO TO 11
52020	C  VQX=0 ON NON-STEM NOTES OF CHORDS. (HENCE NO TAILS)
52100	21	B=10.
52150		IF(L.GT.KN)GO TO 13
52200		GO TO 16
52250	20	JV=JD
52300		IF(VQX.GT.RB)GO TO 21
52350	11	JW=JD
52375		B=20
52400	C  FINDS NEED FOR BEAM TO LEFT 
52500	16	B=B+RA
52700		DO 5 JE=1,6
52800	5	RN(JE+IS)=RN(JE+M)
52900		RN(7+IS)=RN(7+M)+RB-RA*2.
53000	C  ADDS RIGHT NUM. OF BEAMS
53100		IF(L.NE.JV)GO TO 10
53150		IF(L.EQ.KN)GO TO 377
53175		IF(L.NE.K)GO TO 10
53200	377	B=-B
54875	C PARTIAL, UNATTACHED BEAM IS PLACED AUTOMATICALLY IN ITMSUB.
54900		GO TO 8
54905	13	IF(JV.GT.L)GO TO 14
54920		IF(R(7,L+1).LT.10)GO TO 15
54930	C NEXT FOR DOT ON FOLLOWING NOTE.
54940		RN(10+IS)=10.
54950		GO TO 19
54960	15	RN(10+IS)=20.
54970	C SHORT INNER BEAM TO LEFT OF STEM
54975	19	B=-RA
54980		GO TO 16
54990	14	RN(10+IS)=30
54992	C  LONG INNER BEAM
54994		JV=-JV
54996		GO TO 16
54998	
55090	C  PARTIAL BEAM IS ON RIGHT(+) OR LEFT(-).  RBM IS LENGTH.
55091	10	IF(L.EQ.KN)GO TO 22
55092		IF(JV.GE.0)GO TO 17
55094		B=R(3,L)
55096		JV=-JV
55098		L=JV
55100	22	IF(VQ(JW+1).GT.VQ(JW))GO TO 17
55105		VQ(JW)=VQ(JW+1)
55110		JW=JW-1
55196	17	IF(L.NE.JB)GO TO 18
55198		IF(B.LT.20.)L=JV
55200	C PUTS BEAMS IN RIGHT PLACE.
55300	18	RN(9+IS)=R(3,L)
55400	C  THIS WILL BE POS.3
55410		RN(10+IS)=RA+RN(10+IS)
55455	C  DISPLACES
55500		GO TO 8
55600	2	CONTINUE
55700		RETURN
55805	8	JB=JW+1
55810		RN(8+IS)=B
55855	C  FINDS SIDE (L,R) FOR PARTIAL BEAM
56100	C  FOR NEW DISPLACEMENT
56105		RN(IS+11)=-1
56110		CALL UPDATE(9)
56155	C  ADDED ANOTHER ITEM (PART. BEAM)
56200		IF(JB.LE.K)GO TO 6
56400		END
57000	
57100		SUBROUTINE ACSHFT(RX)
57200		COMMON /XRN/RN(2000)
57300		COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA
57400		1,DBST,NFLG,IXX,ISEMI,IQT,F(50),IAMP,K,KN,M,MODE,IBLA
57500		COMMON/RINP/R(10,80),VQ(100)
57600		EQUIVALENCE (A,F(1)),(B,F(2)),(X,F(4)),
57700		1(Y,F(5)),(Z,F(6)),(JD,F(7)),(RN1,F(8)),(RH,F(9))
57800		Z=0
57900		L=K-1
58000		M=L-ABS(RX)
58100		JD=1
58200		RN1=99
58300		Y=-.23
58400		IF(RX.LT.0)GO TO 1
58500		L=M
58600		M=K-1
58700		JD=-1
58800	1	DO 2 N=M,L,JD
58900	C  DOES IT HAVE AN ACCID?
58910		IF(AMOD(R(5,N),10.).EQ.0)GO TO 2
58920		A=0
58940		B=0
59100		IF(N.LT.L)A=R(6,N+1)
59200		IF(N.GT.M)B=R(6,N-1)
59300		IF(RN1.NE.99)GO TO 3
59400	C  IS THIS THE FIRST ACCID?
59500		RN1=R(4,N)
59600		GO TO 6
59700	3	RH=R(4,N)
59800		IF(ABS(RH-RN1).LT.5)GO TO 4
59900		RN1=RH
60000		IF(Y.GT.0)Z=Z+.04
60100	C STOPS OCT., ETC. ACCIS BEING MOVED TO LEFT.
60200		Y=-.23+Z
60300	6	IF(A.EQ.20)GO TO 477
60350		IF(B.NE.20)GO TO 4
60375	477	Y=Z
60400	4	X=0
60500		IF(R(6,N).EQ.20)X=-.24
60600		IF(R(6,N).EQ.10)X=.24
60700		Y=Y+.23
60800		IF(X+Y.LT.1)GO TO 7
60900		RN1=RH
61000		Z=Z+.04
61100		Y=0
61200		IF(A.EQ.20)GO TO 677
61250		IF(B.NE.20)GO TO 577
61275	677	Y=.23
61300	C  SO Y DOESN'T GET >1.
61400	577	Y=Y+Z
61500	7	X=X+Y
61600		IF(ABS(X-.04).LT..01)X=0
61700		IF(X.GE.0)GO TO 5
61800		Y=.23+Z
61900		X=Z
62000	5	R(5,N)=R(5,N)+X
62100	2	CONTINUE
62200		END